home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / misc / stilson / stilson.bas
BASIC Source File  |  1995-10-13  |  4KB  |  119 lines
  1. Option Explicit    'of course!
  2.  
  3. ' If you need something in particular let me know:
  4. ' Steven W. Tilson
  5. ' CIS: 102022,1330
  6. ' 102022,1330@compuserve.com
  7. ' stilson@ATK.COM
  8. ' steve.tilson@windmill.com
  9.  
  10. ' I would never copyright what I consider to be public knowledge.
  11. ' Therefore I claim no rights to the following code nor do I
  12. ' accept responsibility in any form or fashion for the consequences of
  13. ' usage of the code by any party private, commercial, educational, 
  14. ' religious, government, alien, afterlife, or otherwise.
  15. ' Use at your own risk
  16. ' No warranty expressed or implied
  17.  
  18. ' All of this can be found elsewhere if you look.
  19. ' If it looks like you wrote it that is great. Congratulations, you write good code just like me.
  20.  
  21. ' All of this can be derived from the VB Manuals, VB Help files, or the Windows API.
  22.  
  23. ' Windows and VB (Visual Basic) are copyrighted materials of Microsoft Corporation.
  24.  
  25. ' For more great information buy books, magazines, development tools, programming languages,
  26. ' join user groups, participate in forum discussions, or whatever.
  27.  
  28. ' Support the effort and you will be helping mankind to advance from the ooze of modern day anarchy.
  29.  
  30.  
  31. 'Now that all the legal mumbo jumbo is said, select it, cut it, and get to work!
  32.  
  33. 'Whoever does the VB 3.0 FAQ should add this stuff to it.
  34.  
  35. Const WM_USER = &H400  ' straight from the API
  36. Const EM_SETMODIFY = WM_USER + 9 ' straight from the API
  37. Const EM_SETREADONLY = (WM_USER + 31) ' straight from the API
  38.  
  39.     ' The following should be all on one line
  40.  
  41. Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long ' straight from the API
  42.  
  43.     ' end of the all on one line code
  44.  
  45. Sub SetReadOnly (tControl As Control)
  46.     'Sets the specified control to be read only
  47.     Dim s As Long
  48.     s = SendMessage(tControl.hWnd, EM_SETREADONLY, 1, 0)
  49. End Sub
  50.  
  51. ' shell out to a "child" process, wait till done before return
  52.  
  53. Declare Function GetModuleUsage Lib "Kernel" (ByVal hModule As Integer) As Integer
  54.  
  55. Sub GoShell (sShellString As String, iWinType As Integer)
  56. Dim InstanceHandle As Integer, X As Integer
  57.  
  58.     InstanceHandle = Shell(sShellString, iWinType)
  59.  
  60.     Do While GetModuleUsage(InstanceHandle) > 0
  61.         X = DoEvents()
  62.     Loop
  63.  
  64. End Sub
  65.  
  66. ' if you are networked here is how to get the userid from the network:
  67. Declare Function WNetGetUser% Lib "USER" (ByVal User As String, BufSize As Integer)
  68.  
  69. Function GetUser () As String
  70. Dim ReturnCode As Integer, size As Integer, UserName As String
  71.  
  72.     GetUser = "Not logged on to network"
  73.     UserName = String$(255, 0)
  74.     size = Len(UserName)
  75.     ReturnCode = WNetGetUser%(UserName, size)
  76.     If ReturnCode = 0 Then
  77.         While Asc(Mid$(UserName, size, 1)) = 0
  78.             size = size - 1
  79.         Wend
  80.         GetUser = Left$(UserName, size)
  81.     End If
  82. End Function
  83.  
  84. ' how to make sure one date falls after a different date (check valid exp date, etc)
  85. Function GoodDate (First%, Later%)
  86.     GoodDate = False
  87.     FirstSer% = DateSerial(Year(First%), Month(First%), Day(First%))
  88.     LaterSer% = DateSerial(Year(Later%), Month(Later%), Day(Later%))
  89.     If LaterSer% > FirstSer% Then GoodDate = True
  90. End Function
  91.  
  92. ' here is how to float a window on top:
  93. 'Used in Floatwindow sub
  94. ' The following should be all on one line
  95.  
  96. Declare Function SetWindowPos Lib "user" (ByVal H%, ByVal hb%, ByVal x%, ByVal y%, ByVal cx%, ByVal cy%, ByVal F%) As Integer
  97.  
  98. ' end all on one line
  99.  
  100. Const SWP_NOMOVE = 2
  101. Const SWP_NOSIZE = 1
  102. Const SWP_NOACTIVATE = &H10
  103. Const HWND_TOPMOST = -1
  104. Const HWND_NOTOPMOST = -2
  105.  
  106. Sub FloatWindow (F As Form, i As Integer)
  107. 'Makes F "Always on Top" when True is passed,
  108. 'reverse of that when False is passed.
  109.  
  110.     Dim x%
  111.  
  112.     If i Then
  113.         x% = SetWindowPos(F.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE)
  114.     Else
  115.         x% = SetWindowPos(F.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE)
  116.     End If
  117.  
  118. End Sub
  119.